home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / menuEntry.tcl < prev    next >
Encoding:
Text File  |  2004-05-25  |  7.8 KB  |  260 lines
  1. ###############################################################################
  2. ###############################################################################
  3. ##                          menuEntry
  4. ###############################################################################
  5. ###############################################################################
  6. ## Creates an entry widget with right-click context menu.
  7. ###############################################################################
  8. ###############################################################################
  9. ## (c) 2002-2004 AndrΘs Garcφa Garcφa. fandom@retemail.es
  10. ## You may distribute the contents of this file under the terms of the LGPL v2
  11. ###############################################################################
  12. ###############################################################################
  13.  
  14. namespace eval menuEntry {
  15.  
  16. # One of my ugly kludges
  17. if {![info exists labelMenus(cut)]} {
  18.     set ::labelMenus(cut)        Cut
  19.     set ::labelMenus(copy)       Copy
  20.     set ::labelMenus(paste)      Paste
  21.     set ::labelMenus(clear)      Clear
  22.     set ::labelMenus(selectAll) "Select all"
  23.  
  24.     set ::indexMenus(cut)        0
  25.     set ::indexMenus(copy)       2
  26.     set ::indexMenus(paste)      0
  27.     set ::indexMenus(clear)      4
  28.     set ::indexMenus(selectAll)  0
  29. }
  30.  
  31. ###############################################################################
  32. # ReadSel
  33. #    Reads the selection from the clipboard
  34. #
  35. # Returns
  36. #    Whatever was in the clipboard
  37. ###############################################################################
  38. proc ReadSel {} {
  39.     global tcl_platform
  40.  
  41.     if {$tcl_platform(platform)=="unix"} {
  42.         if {![catch {selection get} sel]} {
  43.             return $sel
  44.         }
  45.     }
  46.  
  47.     if {[catch {selection get -selection CLIPBOARD} sel]} return
  48.  
  49.     return $sel
  50. }
  51.  
  52. ###############################################################################
  53. # PopUpMenu
  54. #    Manages the menu that pops up when you right-click in the entry.
  55. #
  56. # Parameters:
  57. #    menu: Path of the menu.
  58. #    entryPath: Path of the entry
  59. #    X-Y: Coordinates where the menu should appear.
  60. ###############################################################################
  61. proc PopUpMenu {menu entryPath X Y} {
  62.     global indexMenus
  63.  
  64.     set sel [ReadSel]
  65.     if {$sel==""} {
  66.         $menu entryconfigure 2 -state disabled -underline $indexMenus(paste)
  67.     } else {
  68.         $menu entryconfigure 2 -state normal   -underline $indexMenus(paste)
  69.     }
  70.     set sel [$entryPath selection present]
  71.     if {$sel==1} {
  72.         $menu entryconfigure 0 -state normal   -underline 1
  73.         $menu entryconfigure 1 -state normal
  74.         $menu entryconfigure 3 -state normal
  75.     } else {
  76.         $menu entryconfigure 0 -state disabled
  77.         $menu entryconfigure 1 -state disabled
  78.         $menu entryconfigure 3 -state disabled
  79.     }
  80.     if {[string length [$entryPath get]]==0} {
  81.         $menu entryconfigure 5 -state disabled
  82.     } else {
  83.         $menu entryconfigure 5 -state normal
  84.     }
  85.  
  86.     $menu entryconfigure 0 -underline $indexMenus(cut)
  87.     $menu entryconfigure 1 -underline $indexMenus(copy)
  88.     $menu entryconfigure 2 -underline $indexMenus(paste)
  89.     $menu entryconfigure 3 -underline $indexMenus(clear)
  90.     $menu entryconfigure 5 -underline $indexMenus(selectAll)
  91.  
  92.     tk_popup $entryPath.menu $X $Y
  93.  
  94.     return
  95. }
  96. ###############################################################################
  97. # Cut - Copy - Paste - Clear - Selec
  98. #    They do what they are supposed to.
  99. #
  100. # Parameters:
  101. #    entryPath: Path of the entry
  102. ###############################################################################
  103. proc Cut {entryPath} {
  104.     set sel [$entryPath selection present]
  105.     if {$sel==1} {
  106.         event generate $entryPath <<Cut>>
  107.     }
  108.     return
  109. }
  110.  
  111. proc Copy {entryPath} {
  112.     set sel [$entryPath selection present]
  113.     if {$sel==1} {
  114.         event generate $entryPath <<Copy>>
  115.     }
  116.     return
  117. }
  118.  
  119. proc Paste {entryPath} {
  120.     event generate $entryPath <<Paste>>
  121.     return
  122. }
  123.  
  124. proc Clear {entryPath} {
  125.     set sel [$entryPath selection present]
  126.     if {$sel==1} {
  127.         event generate $entryPath <<Clear>>
  128.     }
  129.     return
  130. }
  131.  
  132. proc Selec {entryPath} {
  133.     $entryPath select range 0 end
  134.     clipboard clear
  135.     return
  136. }
  137.  
  138. ###############################################################################
  139. # FocusIn
  140. #    When the entry gets the focus, this procedure will select the whole
  141. #    content.
  142. ###############################################################################
  143. proc FocusIn {entryPath} {
  144.     variable entries
  145.  
  146.     if {$entries($entryPath)==0} {
  147.         set entries($entryPath) 1
  148.         $entryPath selection range 0 end
  149.     }
  150.  
  151.     return
  152. }
  153.  
  154. ###############################################################################
  155. # FocusOut
  156. #    When the entry loses the focus, this procedure will prepare for the next
  157. #    time it gets it.
  158. ###############################################################################
  159. proc FocusOut {entryPath} {
  160.     variable entries
  161.  
  162.     set entries($entryPath) 0
  163.  
  164.     return
  165. }
  166.  
  167. ###############################################################################
  168. # RightClick
  169. #    The following mess makes sure the insert cursor is placed in the
  170. #    character where you right-click, all the while keeping the selection
  171. #    if you had one.
  172. ###############################################################################
  173. proc RightClick {entryPath x y X Y} {
  174.     variable sel1
  175.     variable sel2
  176.  
  177.     set sel [$entryPath selection present]
  178.     if {$sel==1} {
  179.         set selp 1
  180.         set sel1 [$entryPath index sel.first]
  181.         set sel2 [$entryPath index sel.last]
  182.     } else {
  183.         set selp 0
  184.     }
  185.     event generate $entryPath <Button-1>        -x $x -y $y
  186.     event generate $entryPath <ButtonRelease-1> -x $x -y $y
  187.     if {$selp==1} {
  188.         $entryPath selection range $sel1 $sel2
  189.     }
  190.     menuEntry::PopUpMenu $entryPath.menu $entryPath $X $Y
  191.  
  192.     return
  193. }
  194.  
  195. ###############################################################################
  196. # menuEntry
  197. #    Creates the entry widget.
  198. #
  199. # Parameter:
  200. #    entryPath: The path to the entry.
  201. #    args: The arguments that will be passed whole to the standard entry.
  202. #
  203. # Returns:
  204. #    The path of the entry
  205. ###############################################################################
  206. proc menuEntry {entryPath args} {
  207.     global labelMenus tcl_platform
  208.     variable entries
  209.  
  210.     entry $entryPath
  211.     eval $entryPath configure $args
  212.  
  213.     set menu [menu $entryPath.menu -tearoff 0]
  214.     $menu add command -label $labelMenus(cut)       \
  215.             -command "menuEntry::Cut   $entryPath"
  216.     $menu add command -label $labelMenus(copy)      \
  217.             -command "menuEntry::Copy  $entryPath"
  218.     $menu add command -label $labelMenus(paste)     \
  219.             -command "menuEntry::Paste $entryPath"
  220.     $menu add command -label $labelMenus(clear)     \
  221.             -command "menuEntry::Clear $entryPath"
  222.     $menu add separator
  223.     $menu add command -label $labelMenus(selectAll) \
  224.             -command "menuEntry::Selec $entryPath"
  225.  
  226.     bind $entryPath <Button-3> "menuEntry::RightClick %W %x %y %X %Y"
  227.     if {$::getleftState(os)=="win"} {
  228.         bind $entryPath <App>  "menuEntry::RightClick %W %x %y %X %Y"
  229.     } else {
  230.         bind $entryPath <Menu> "menuEntry::RightClick %W %x %y %X %Y"
  231.     }
  232.  
  233.     if {$::tcl_platform(platform)!="windows"} {
  234.         bind $entryPath <Control-v> "
  235.             event generate %W <<Paste>>
  236.             break
  237.         "
  238.         bind $entryPath <ButtonRelease-2> break
  239.     }
  240.     bind $entryPath <Button-2> "
  241.         event generate %W <<Paste>>
  242.         break
  243.     "
  244.     bind $entryPath <Control-V> "
  245.         event generate %W <<Paste>>
  246.         break
  247.     "
  248.     bind $entryPath <FocusIn>  "menuEntry::FocusIn  $entryPath"
  249.     bind $entryPath <FocusOut> "menuEntry::FocusOut $entryPath"
  250.  
  251.     bind $entryPath <<Paste>>  "
  252.         catch {$entryPath delete sel.first sel.last}
  253.     "
  254.  
  255.     set entries($entryPath) 0
  256.  
  257.     return $entryPath
  258. }
  259. }
  260.